home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / asm / pc370_3.exe / lha / PRINTDOC.ALC < prev    next >
Text File  |  1988-01-03  |  6KB  |  263 lines

  1.     TITLE 'PRINT - PC/370 PRINT UTILITY'
  2. *
  3. * AUTHOR.    Don Higgins.
  4. * DATE.      03/29/86. (Copied and modified from DEMOSRC.ALC)
  5. * REMARKS.   PC/370 utility program to read selected text file
  6. *            and print it with page control.
  7. *
  8. * COPYRIGHT. None.  This is a public domain program.
  9. *
  10. * MAINTENANCE.
  11. *
  12. * 05/18/87 CONVERTED TO RELEASE 2 DCB FORMAT
  13. *
  14. * INPUT
  15. *
  16. *  1.  A>PRINT drive:file
  17. *
  18. * OUTPUT
  19. *
  20. *  1.  File will be printed on the standard printer device with
  21. *      page control added via TITLE, EJECT, and SPACE statements as
  22. *      defined in standard OS/VS assembler.
  23. *
  24. PRINT    CSECT
  25.     LR    R13,R15
  26.     USING PRINT,R13
  27.     LA    R2,=C'PC/370 PRINT UTILITY R2.0 05/18/87$'
  28.     SVC   WTO
  29.     LA    R2,=C' $'
  30.     SVC   WTO
  31.     LA    R2,SYSUT1
  32.     USING IHADCB,R2
  33.     L     R1,0(R1)  ADDR PARM LENGTH
  34.     LA    R1,3(R1)  SET R1 = FILENAME IN PARM+1
  35.     ST    R1,DCBDSN SET FILENAME ADDR IN DCB
  36.     DROP  R2
  37.     SVC   OPEN
  38.     LA    R1,ASCTITLE
  39.     LA    R2,L'ASCTITLE+L'ASCEJECT+L'ASCSPACE
  40.     SVC   EBCASC
  41.     LA    R2,=C'ENTER P FOR PRINTER OUTPUT OR ANY KEY FOR CONSOLE$'
  42.     SVC   WTO
  43.     SVC   READKEY
  44.     STC   R0,OPTION
  45. MAINLOOP EQU   *
  46.     BAL   R12,GETREC
  47.     LTR   R15,R15         TEST FOR END OF FILE
  48.     BNZ   EOJ
  49.     BAL   R14,SCAN
  50.     LTR   R15,R15         TEST FOR COMMAND AND SKIP PRINTING IT
  51.     BNZ   MAINLOOP
  52.     AP    LINE,=P'1'
  53.     CP    LINE,MAXLINE
  54.     BNH   NEXTLINE
  55.     BAL   R11,NEWPAGE
  56. NEXTLINE EQU   *
  57.     LA    R0,RECORD
  58.     BAL   R12,PUTREC
  59.     B     MAINLOOP
  60. EOJ      EQU   *
  61.     LA    R2,SYSUT1
  62.     SVC   CLOSE
  63.     SVC   EXIT
  64.     TITLE 'SCAN FOR TITLE, EJECT, AND SPACE COMMANDS'
  65. SCAN     EQU   *
  66.     CLI   RECORD,ASCBLK
  67.     BE    SCANOP
  68.     CLI   RECORD,ASCTAB
  69.     BNE   SCANEXIT        EXIT IF FIRST CHAR. NOT BLANK OR TAB
  70. SCANOP   EQU   *
  71.     LA    R4,RECORD+1
  72. SKIPBLK  EQU   *
  73.     CLI   0(R4),ASCLF
  74.     BE    SCANEXIT
  75.     CLI   0(R4),ASCBLK
  76.     LA    R4,1(R4)
  77.     BE    SKIPBLK
  78.     BCTR  R4,0
  79.     CLC   0(5,R4),ASCTITLE
  80.     BE    TITLE
  81.     CLC   0(5,R4),ASCEJECT
  82.     BE    EJECT
  83.     CLC   0(5,R4),ASCSPACE
  84.     BE    SPACE
  85. SCANEXIT EQU   *
  86.     SR    R15,R15
  87.     BR    R14
  88. TITLE    EQU   *
  89.     LA    R4,5(R4)
  90. FINDQ1   EQU   *
  91.     CLI   0(R4),ASCBLK
  92.     BL    SCANEXIT     IGNORE TITLE IF FIRST QUOTE NOT FOUND
  93.     CLI   0(R4),ASCQ
  94.     LA    R4,1(R4)
  95.     BNE   FINDQ1
  96.     LA    R3,TITLEMSG
  97. FINDQ2   EQU   *
  98.     CLI   0(R4),ASCBLK
  99.     BL    SETTITLE     TRUNCATE IF SECOND QUOTE NOT FOUND
  100.     CLI   0(R4),ASCQ
  101.     BE    SETTITLE
  102.     CL    R3,=A(TITLEMSG+L'TITLEMSG)
  103.     BNL   SETTITLE     TRUNCATE IF TOO LONG
  104.     MVC   0(1,R3),0(R4)  COPY TITLE
  105.     LA    R3,1(R3)
  106.     LA    R4,1(R4)
  107.     B     FINDQ2
  108. SETTITLE EQU   *
  109.     CL    R3,=A(TITLEMSG+L'TITLEMSG)
  110.     BNL   EJECT
  111.     MVI   0(R3),ASCBLK    PAD WITH BLANKS
  112.     LA    R3,1(R3)
  113.     B     SETTITLE
  114. EJECT    EQU   *
  115.     BAL   R11,NEWPAGE
  116.     LA    R15,1
  117.     BR    R14
  118. SPACE    EQU   *
  119.     LA    R0,SPACEMSG
  120.     BAL   R12,PUTREC
  121.     LA    R0,SPACEMSG
  122.     BAL   R12,PUTREC
  123.     AP    LINE,=P'2'
  124.     LA    R15,1
  125.     BR    R14
  126.     TITLE 'NEWPAGE - PRINT HEADING'
  127. NEWPAGE  EQU   *
  128.     AP    PAGE,=P'1'
  129.     ZAP   LINE,=P'0'
  130.     MVC   DPAGE,MASK
  131.     ED    DPAGE,PAGE
  132.     MVC   PAGEMSG,PAGEWORK
  133.     LA    R1,PAGEMSG
  134.     LA    R2,L'PAGEMSG
  135.     SVC   EBCASC
  136.     LA    R0,HEADING
  137.     BAL   R12,PUTREC
  138.     MVI   HEADCC,ASCFF   FORCE FORM FEED AFTER FIRST PAGE
  139.     LA    R0,SPACEMSG
  140.     BAL   R12,PUTREC     SKIP SPACE AFTER TITLE
  141.     BR    R11
  142.     TITLE 'GETREC - GET NEXT TEXT RECORD OR SET EOF'
  143. GETREC   EQU   *
  144.     LA    R2,SYSUT1
  145.     LA    R1,RECORD
  146.     SVC   GET
  147.     SR    R15,R15
  148.     BR    R12
  149. EOFRTN   EQU   *
  150.     LA    R15,1
  151.     BR    R12
  152. SYNRTN   EQU   *
  153.     LA    R2,=C'IO ERROR$'
  154.     SVC   WTO
  155.     SVC   TRACE
  156.     DC    C'BUG '
  157.     TITLE 'PUTREC - PUT RECORD TO STD. PRINT DEVICE'
  158. PUTREC   EQU   *
  159.     LR    R4,R0
  160. PUTLOOP  EQU   *
  161.     IC    R2,0(R4)
  162.     CLI   0(R4),ASCTAB
  163.     LA    R3,1
  164.     BNE   PUTCHAR
  165.     LA    R3,9
  166.     LA    R2,ASCBLK
  167. PUTCHAR  EQU   *
  168.     SVC   CONSOLEC       PRINT ON CONSOLE
  169.     CLI   OPTION,ASCP
  170.     BE    ISUSVC
  171.     CLI   OPTION,ASCPL
  172.     BE    ISUSVC
  173.     B     PUTSKPP
  174. ISUSVC   SVC   PRINTC         PRINT ON STD. OUTPUT DEVICE ALSO
  175. PUTSKPP  EQU   *
  176.     BCT   R3,PUTCHAR
  177.     CLI   0(R4),ASCLF
  178.     LA    R4,1(R4)
  179.     BNE   PUTLOOP
  180. PUTEXIT  EQU   *
  181.     SR    R15,R15
  182.     BR    R12
  183.     TITLE 'DATA SECTION'
  184.     LTORG
  185. *
  186. * REGISTER USAGE
  187. *
  188. R0       EQU   0 SVC RETURN CODE
  189. R1       EQU   1 SVC ARGUMENT
  190. R2       EQU   2 SVC ARGUMENT (DCB ADDRESS, DMA, MSG, ETC.)
  191. R3       EQU   3 POINTER FOR MOVING TITLE
  192. R4       EQU   4 OUTPUT BYTE PTR FOR PUTREC
  193. R11      EQU   11 LINK FOR NEWPAGE
  194. R12      EQU   12 LINK FOR GETREC AND PUTREC
  195. R13      EQU   13 BASE
  196. R14      EQU   14 LINK FROM MAINLINE TO ROUTINES
  197. R15      EQU   15 RETURN CODE FROM ROUTINES
  198. *
  199. * PC/370 SVC'S
  200. *
  201. EXIT     EQU   0
  202. OPEN     EQU   1
  203. CLOSE    EQU   2
  204. GET      EQU   5
  205. PUT      EQU   6
  206. TRACE    EQU   9
  207. GMAIN    EQU   10
  208. FMAIN    EQU   11
  209. ASCEBC   EQU   12
  210. EBCASC   EQU   13
  211. READKEY  EQU   200+1  MS-DOS SVC 1 READ KEY
  212. CONSOLEC EQU   200+2  MS-DOS SVC 2 DISPLAY CHAR IN R2 ON CONSOLE
  213. PRINTC   EQU   200+5  MS-DOS SVC 5 PRINT CHAR IN R2 ON STD. PRINTER
  214. WTO      EQU   200+9  MS-DOS SVC 9 PRINT STRING WITH ENDING $ ON CON.
  215. *
  216. * DATA AREAS
  217. *
  218. TBUFF    EQU   X'80'  BUFFER FOR DIRECTORY SEARCH
  219. RECORD   DS    XL256   LOGICAL RECORD AREA
  220. ASCLF    EQU   X'0A'   ASCII LINE FEED
  221. ASCCR    EQU   X'0D'   ASCII CARRIAGE RETURN
  222. ASCASK   EQU   X'2A'   ASCII ASTERISK FOR ALC COMMENT CHECK
  223. ASCBLK   EQU   X'20'   ASCII SPACE
  224. ASCQ     EQU   X'27'   ASCII QUOTE
  225. ASCTAB   EQU   X'09'   ASCII TAB
  226. ASCFF    EQU   X'0C'   ASCII FORM FEED
  227. ASCP     EQU   X'50'   UPPERCASE ASCII P
  228. ASCPL    EQU   X'70'   LOWER CASE ASCII P
  229. OPTION   DC    X'00'
  230. ASCTITLE DC    C'TITLE'
  231. ASCEJECT DC    C'EJECT'
  232. ASCSPACE DC    C'SPACE'
  233. PAGE     DC    PL2'0'
  234. LINE     DC    PL2'50'
  235. MAXLINE  DC    PL2'50'
  236. MASK     DC    X'40202020'  EDIT MASK FOR PL2
  237. HEADING  EQU   *
  238. HEADCC   DC    AL1(ASCBLK)
  239. TITLEMSG DC    0CL65' ',65AL1(ASCBLK),2AL1(ASCBLK)
  240. PAGEMSG  DC    0CL8' ',9AL1(ASCBLK)
  241. SPACEMSG DC    AL1(ASCCR,ASCLF)     END OF HEADING
  242. WORK     DC    0CL20' '
  243. PAGEWORK DC    0CL8' ',C'PAGE'
  244. DPAGE    DC    CL4' ZZZ'
  245.     COPY  CPY/IHADCB
  246. *
  247. * END OF DSECT
  248. *
  249. PRINT    CSECT
  250. SYSUT1   DC    0F'0',C'ADCB'
  251.     DC    A(TBUFF+7)           PATH/FILE NAME IN OS/VS PARM
  252.     DC    X'FFFF'
  253.     DC    X'00'
  254.     DC    C'SGT'               SEQ. GET TEXT
  255.     DC    X'0A1A'
  256.     DC    H'255'               LRECL
  257.     DC    H'8192'              BLKSZ
  258.     DC    A(EOFRTN)            EODAD
  259.     DC    A(SYNRTN)            SYNAD
  260.     DC    A(RECORD)            RECORD AREA
  261.     DC    XL(SYSUT1+LDCB-*)'00'
  262.     END   PRINT
  263.